Macwelt 1/Macwelt DVD 1.toast/Web-Publishing/HTML-Editoren/Alpha ƒ/Tcl/SystemCode/clickUtils.tcl

Text File | 2001-01-17 | 6.0 KB | 254 lines

## -*-Tcl-*-
 # ###################################################################
 #  AlphaTcl - core Tcl engine
 #
 #  FILE: "clickUtils.tcl"
 #                                    created: 11/2/96 {9:17:08 am}
 #                                last update: 01/17/2001 {15:57:41 PM}
 ##

# ◊◊◊◊ Option click in titlebar ◊◊◊◊ #

# Now doesn't add anything extra for windows which are not saved to disk.
# To deal with shells and other similar windows.  More general than only
# doing this for shell mode.
proc optClickTB_List {} {
    global minItemsInTitlePopup
    set lines [mode::proc OptionTitlebar]
    if {[llength $lines] < $minItemsInTitlePopup} {
    return [::OptionTitlebar $lines]
    } else {
    return $lines
    }
}

proc ::OptionTitlebar {{lines ""}} {
    if {[file exists [win::StripCount [win::Current]]]} {
    pushd [file dirname [win::Current]]
    if {[llength $lines]} {
        eval lappend lines "-" [glob -nocomplain *]
    } else {
        set lines [glob -nocomplain *]
    }
    popd
    }
    return $lines
}

##
 # -------------------------------------------------------------------------
 #
 # "optClickTB_Pick" --
 #
 #  Called when you select an item from the option-click pop-up.  Call a
 #  mode-specific procedure if possible, else assume it's a file in the
 #  same directory as the current window, and open it.  If the mode
 #  specific procedure ends in an error, we use the default version.
 # -------------------------------------------------------------------------
 ##
proc optClickTB_Pick {item} {
    if {[catch {mode::proc OptionTitlebarSelect $item}]} {
    ::OptionTitlebarSelect $item
    }
}

proc ::OptionTitlebarSelect {item} {
    if {[file isdirectory [file join [file dirname [win::Current]] $item]]} {
    file::showInFinder [file join [file dirname [win::Current]] $item]
    } else {
    file::tryToOpen $item
    }
}

# ◊◊◊◊ Command click on window title ◊◊◊◊ #

# Called from Alpha when titlebar "title" menu selected (command-mouse).
proc getTitleBarPath {} {
    set win [win::Current]

    # If a hooked procedure can handle this, let it.
    if {![catch [list hook::callUntilOk titlebarListHook * $win] res]} {
    return $res
    }

    return $win
}

proc titlebar {name} {
    set win [win::Current]

    # If a hooked procedure can handle this, let it.
    if {[hook::callUntil titlebarSelectHook * $win $name]} {
    return
    }

    # To avoid troubles on Windoze with paths...
    set name [file::ensureStandardPath $name]
    if {$name == $win} {
    if {[key::shiftPressed]} {
        file::showInFinder
    } else {
        putScrap $name
        message "Copied full path of '[file tail $name]' to the Clipboard."
    }
    } else {
    if {[key::shiftPressed]} {
        file::showInFinder $name
    } else {
        findFile $name
    }
    }
}

# ◊◊◊◊ Command Double Click ◊◊◊◊ #

proc cmdDoubleClick {{from -1} {to -1} {shift 0} {option 0} {control 0}} {
    global mode

    if {[expandURL] != ""} {
    sendUrl [getSelect]
    } else {
    if {$from < 0} {
        set from [getPos]
        set to [selEnd]
        if {[pos::compare $from == $to]} {
        hiliteWord
        set from [getPos]
        set to [selEnd]
        }
    }
    if {[set proc [mode::getProc DblClick]] != ""} {
        if {[llength [info args $proc]] == 2} {
        $proc $from $to
        } else {
        $proc $from $to $shift $option $control
        }
    } else {
        message "No docs"
    }
    }
}

proc commandClick {from to url} {
    select $from
    for {set i 0} {$i < 200} {incr i} {}
    select $from $to
    for {set i 0} {$i < 200} {incr i} {}
    select $from
    for {set i 0} {$i < 200} {incr i} {}
    select $from $to
    url::execute $url
}

# ◊◊◊◊ URL handling ◊◊◊◊ #

# (WTP 7/30/95) Slightly improved 'sendUrl'.
# By accepting a text arg, this can now be used to make sendUrl
# hypertext links (useful for "mailto" links in documentation, f'rinstance)
#===============================================================================

proc sendUrl {{text {}}} {
    if {$text == {}} { catch {set text [getSelect]} }
    if {$text == {}} { set text [prompt {URL?} {}] }
    if {[string length $text] == 0} { return }
    url::execute $text
}

proc expandURL {} {
    set pos [getPos]
    set beg [lineStart $pos]
    set whe [search -s -n -f 1 -r 1 -i 1 -m 0 -l [nextLineStart $pos] \
      {[a-zA-Z0-9]+://[a-zA-Z/._0-9%~?\&=,-]+} $beg]
    if {[string length $whe]} {
    if {([pos::compare $pos >= [lindex $whe 0]]) \
      && ([pos::compare $pos < [lindex $whe 1]])} {
        eval select $whe
        return $whe
    }
    }
}



# ◊◊◊◊ Printing helpers ◊◊◊◊ #

proc printLeftHeader {pg {f ""}} {
    global printHeader printHeaderTime printHeaderFullPath

    if {!$printHeader} return

    if {$f == ""} {set f [win::Current]}
    if {$printHeaderFullPath} {
    set text $f
    } else {
    set text [file tail $f]
    }

    if {$printHeaderTime} {
    append text "      [join [mtime [now] short]]"
    }
    return $text
}

proc printRightHeader {pg {f ""}} {
    global printHeader
    if {!$printHeader} return
    return "Page $pg"
}

proc printAll {} {
    foreach f [winNames -f] {
    print $f
    }
}

# ◊◊◊◊ Spellcheck helpers ◊◊◊◊ #

#================================================================================
# Excalibur is the only Mac spell-checker that I know of which will handle
# LaTeX as well as ordinary text.

array set spellCheckAppSignatures {
    Excalibur XCLB
}

array set spellCheckAppScripts {
    Excalibur {
    {sendOpenEvent noReply $quotedSig $filename}
    }
}

proc spellcheckWindow {} {
    global spellCheckSig

    if {[winDirty]} {
    if {[dialog::yesno "Save '[win::CurrentTail]'?"]} {
        save
    }
    }
    app::runScript spellCheck "Spell Checker" [win::StripCount [win::Current]]
    hook::register resumeModifiedHook spellcheckResume [win::Current]
}

proc spellcheckResume {name mod} {
    if {$mod} {
    bringToFront $name
    revert
    }
    hook::deregister resumeModifiedHook spellcheckResume $name
}

proc spellcheckSelection {} {
    global spellCheckSig
    if {[pos::compare [getPos] == [selEnd]]} {
    beep
    message "No selection"
    return
    }
    copy
    set name [app::launchBackSigs XCLB spellCheckSig "Please locate your spell checker"]
    switchTo $name
}